COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE	LTCONS
C00003 00003	 (LTSET1 <size> <bporg> <bpend> <flag>)
C00006 00004	 (LTREL1 BPORG BPEND)
C00007 00005	 (LTCONS <already consed list>) -- (LTXCONS A B)
C00011 00006	 (UNLTCONS <ltcons'ed list>)
C00013 00007	 (LTOCCUPANCY) (LTAVERAGELOOKUP)(LTMAXLOOKUP)
C00016 ENDMK
C⊗;
	TITLE	LTCONS

; LINEAR QUOTIENT HASHED CONS -- NOT QUITE AS GOOD AS QUAD. QUOTIENT, BUT
; EACH PROBE IS QUICKER, SO RESULT IS BETTER USUALLY.

INTERNAL LTCONS,LTXCONS,LTSET1,LTREL1,UNLTCONS
EXTERNAL CONS,XCONS,NUMVAL,FIX1A,JOBREL

P←←14
A←←1
B←←2
C←←3
D←←4
ORIGPT←←5			;ORIGINAL HASHED ADDR FOR DONE TEST
CONSED←←6			;LT CONSED WORD, AFTER LTCONSING CAR/CDR
HASLEN←←7			;LENGTH OF HASH TABLE
INUM0←←577777
; (LTSET1 <size> <bporg> <bpend> <flag>)
; Allocate data for hash conses, flag is T for BPS, NIL for topcor.

LTSET1:	SKIPE	.HASLEN		;If there already is a hash space, (RETURN NIL)
	 JRST	 FALSE
	SETZM	NIL.NIL		;SPECIAL WORD FOR (NIL)
	MOVEM	2,BPRSV1	;Save original (Lisp-form) numbers
	MOVEM	3,BPNDSV
	MOVEM	4,FLAGSV
	PUSHJ	P,NUMVAL	;Fetch values: 
	PUSH	P,1		; 1: size
	MOVEM	1,.HASLEN
	MOVE	1,BPRSV1	; 2: current bporg
	PUSHJ	P,NUMVAL	; 3: current bpend
	PUSH	P,1		; 4: flag (unchd.) T means BPS, NIL topcore
	MOVE	1,BPNDSV
	PUSHJ	P,NUMVAL
	MOVE	3,1
	POP	P,2
	POP	P,1
	SKIPE	FLAGSV		;Which?
	 JRST	 LDBPS		; NIL -- BPS
	MOVE	2,JOBREL
	ADDI	2,1		;Get enough core to hold the space
	MOVE	3,1		; implied by the size in 1
	ADDI	3,-1(2)
	CORE	3,
	 JRST	 FALSE		;Failed to set up hash space
	MOVE	3,JOBREL	;New top size
LDBPS:	MOVEM	2,.HASBAS	;Store base addr, make sure there's
	MOVE	4,3		; enough room, store end address
	SUBI	4,-1(2)		;   (real available size must be
	CAMGE	4,1		;     ≥ needed one)
	JRST	FALSE
	MOVE	3,2
	ADD	3,1
	MOVEM	3,.HASEND
	SETZM	.FULL		;Prepare for LTCONS
	SETZM	(2)		;Clear new array
	HRLI	2,1(2)
	MOVSS	2
	BLT	2,-1(3)
TRUTH:	MOVE	1,3		;Return new BPORG loc, LTSET will store in
	PUSHJ	P,FIX1A		; BPORG, return T
	MOVEM	1,BPRGSV
	POPJ	P,
FALSE:	MOVEI	1,		;(RETURN NIL)
	POPJ	P,
; (LTREL1 BPORG BPEND)

LTREL1:	SKIPN	.HASLEN		;Don't release what you don't have
	 JRST	 FALSE
	SETZM	.HASLEN		;Don't have any more
	SKIPN	FLAGSV		;IF IN BPS, ONE TECHNIQUE, ELSE ANOTHER
	 JRST	 CORREL
	CAMN	2,BPNDSV	;FORGET IF BPENDS NOT SAME
	CAME	1,BPRGSV	;OR IF BPORG HAS MOVED SINCE LTSET
	 JRST	 FALSE		;DON'T CHANGE BPORG BACK
	MOVE	1,BPRSV1	;ORIGINAL BPORG
	POPJ 	P,		;NEW BPORG, CONSIDER IT RELEASED
CORREL:	SOS	1,.HASBAS
	CORE	1,
	 JRST	 FALSE		;I DON'T UNDERSTAND IT
	 JRST	 FALSE

; (LTCONS <already consed list>) -- (LTXCONS A B)

LTXCONS:PUSHJ	P,XCONS		;EXCHANGED CONS
LTCONS:	MOVE	HASLEN,.HASLEN	;HASH TABLE/CONS TABLE LEGTH
	MOVE	D,HASLEN	;INDICATES ONE PROBE ONLY
				;D IS HASLEN IF INITIAL HASH SUCCEEDS
				;     -1(HASLEN) IF FIRST OFLOW SUCCEEDS
				;     ETC.
	SETZM	.FULL		;ON IF TABLE FULL (W/O THIS CONS)
LCONS1:	HRRZS	A		;CLEAR LH GARBAGE
	JUMPE	A,CPOPJ		;((NULL L) NIL)
	SKIPE	.FULL		;IF FULL ALREADY, RETURN INPUT
	 POPJ	 P,
	CAML	A,.HASBAS	;((ALREADYLONGTERMED L) L)
	CAML	A,.HASEND
	 JRST	 .+2
CPOPJ:	POPJ	P,
	CAILE	A,377777
	 JRST	 CPOPJ
	HLRE	B,(A)		;((ATOM L) L)
	AOJE	B,CPOPJ
				; (T (HASHCONS (LTCONS (CAR L))(LTCONS (CDR L)))
	SKIPN	B,(A)
	 JRST	 NNRET		; (NIL) -- SPECIAL RETURN
	HRL	ORIGPT,A	;SAVE PTR AND CONSED VALUE
	PUSH	P,ORIGPT
	PUSH	P,B
	HLRZ	A,(A)		;CAR IS LONG TERM
	PUSHJ	P,LCONS1
	HRLZS	A		;SAVE HERE
	EXCH	A,(P)		;CDR ORIG
	PUSHJ	P,LCONS1
	HRRM	A,(P)
	POP	P,CONSED	;CONSED IS LT-CONSED
	POP	P,ORIGPT	;LH IS ORIG PTR TO ORIG CONSED
	SKIPE	.FULL		;IF FULL NOW, CONS RESULTS
	 JRST	 FULL
	HLRZ	B,CONSED

; INITIAL HASH -- CAR XOR CDR
; A IS CDR LONGED, B IS CAR LONGED, CONSED IS NEW CONS WORD
	XOR	A,B
	IDIV	A,HASLEN
	EXCH	A,B
	ADD	A,.HASBAS
; A IS TABLE BASE + RESIDUE -- NEED TO KEEP QUOTIENT B FOR INCREMENT
; CHECK IF FIRST HASH HIT RIGHT NUMBER OR A FREE ENTRY
	SKIPN	(A)		;IS THERE SOMETHING IN THIS CELL?
	MOVEM	CONSED,(A)	;NO, NEW CONS -- THIS IS IT
	CAMN	CONSED,(A)	;IS IT THIS ONE?
	 POPJ	 P,		; YES, INDEED, DONE IN ONE

; PREPARE FOR INCREMENT LOOP
	HRR	ORIGPT,A	;TO DETECT TABLE FULL, LH IS ORIG PTR
	IDIV	B,HASLEN	;QUOTIENT MOD LENGTH IS INCREMENT FN.
	JUMPN	C,.+2
	MOVEI	C,1
	MOVEI	D,-1(HASLEN)	;COUNT INSTANCES

; EACH SUBSEQUENT PROBE LOCATION IS (PREVIOUS + QUOTIENT) MOD HASLEN -- THIS
; WILL COVER THE WHOLE TABLE BECAUSE HASLEN IS PRIME.

LK1:	ADD	A,C
	CAML	A,.HASEND
 	 SUBI	 A,(HASLEN)
	SKIPN	(A)
	MOVEM	CONSED,(A)
	CAMN	CONSED,(A)
	 POPJ	 P,
	SOJG	D,LK1

FULL:	SETOM	.FULL
	HLRZ	A,ORIGPT
	CAMN	CONSED,(A)	;BOTH SIDES FULL?
	 POPJ	 P,		;YES
	HLRZ	A,CONSED
	HRRZ	B,CONSED
	JRST	CONS

NNRET:	MOVEI	A,NIL.NIL	;NIL.NIL IS 0, OR (NIL)
	POPJ	P,
; (UNLTCONS <ltcons'ed list>)

UNLTCONS:PUSHJ	P,UNLT
	MOVE	B,.HASBAS
	SUB	B,.HASEND
	HRLZS	B
	HRR	B,.HASBAS
CLNUP:	SKIPGE	(B)
	SETZM	(B)
	AOBJN	B,CLNUP
	HRRZS	A
	POPJ	P,

UNLT:	HRRZS	A
	JUMPE	A,CPOPJ
	CAILE	A,377777
	 POPJ	 P,
	HLRE	B,(A)
	AOJE	B,CPOPJ		;ATOM
	AOJE	B,[HRRZ A,(A)	;ALREADY HANDLED CONS
		   JRST CPOPJ]
	PUSH	P,(A)		;CONS PAIR
	MOVEI	B,		;MAKE (CONS NIL <HASH TABLE CONS ADR>)
	PUSHJ	P,XCONS
	HRLI	A,-2
	MOVEM	A,@(A)		;NEW RESULT IN OLD WORD, LH MARKS DONE
	PUSH	P,A		;FINAL RESULT
	HLRZ	A,-1(P)
	PUSHJ	P,UNLT		;UNLTCONS THE CAR
	EXCH	A,-1(P)		;SAVE THE RESULT, AND
	PUSHJ	P,UNLT		; UNLTCONS THE CDR
	POP	P,B		;FINAL RESULT
	POP	P,C		;CAR RESULT
	HRL	A,C		;(CONS (CAR RESULT) (CDR RESULT))
	MOVEM	A,(B)		;PUT CONS INTO RESULT
	HRRZ	A,B
	POPJ	P,
; (LTOCCUPANCY) (LTAVERAGELOOKUP)(LTMAXLOOKUP)
;  Ltoccupancy returns number of words filled. User must already
;	know table size;
;  Ltlookupaverage returns the average # of table probes needed to
;	do an LTCONS, at the present time.
;  Ltmaxlookup returns the length of the longerst chain.


LTOCCUPANCY↑:
	MOVN	B,.HASLEN
	HRLS	B
	HRR	B,.HASBAS
	MOVEI	A,
LTOLP:	SKIPE	(B)
	ADDI	A,1
	AOBJN	B,LTOLP
	JRST	FIX1A↑

LTAVERAGELOOKUP↑:
	PUSH	P,[0]		;-MAX CHAIN	  (-3)
	PUSH	P,[0]		;-SUM OF CHAINS    (-2)
	PUSH	P,[0]		;-COUNT OF ENTRIES (-1)
	PUSH	P,.HASBAS	;→FIRST ENTRY	  (0)
AVLP:	AOS	B,(P)
	CAMLE	B,.HASEND	;DONE?
	 JRST	 AVDN		;YES
	SKIPN	C,-1(B)		;THIS ENTRY OCCUPIED?
	 JRST	 NOENT		;NO
	SOS	-1(P)		;COUNT ENTRIES
	PUSH	P,C		;CREATE CONS WORD OUTSIDE HASH SPACE
	MOVEI	A,(P)
	PUSHJ	P,LTCONS	;D IS HASLEN+1 - #PROBES
	SUB	P,[1,,1]
	SUBI	D,1(HASLEN)	;-#PROBES
	ADDM	D,-2(P)
	CAMGE	D,-3(P)
	 MOVEM	 D,-3(P)	;MAX # PROBES
NOENT:	AOS	(P)
	JRST	AVLP
AVDN:	SUB	P,[1,,1]
	POP	P,B
	POP	P,A
	IDIV	A,B
	PUSHJ	P,FIX1A↑	;RESULT
	POP	P,B		;-MAX CHAIN
	POPJ	P,		;DONE

LTMAXLOOKUP↑:
	PUSHJ	P,LTAVERAGELOOKUP
	MOVN	A,B
	JRST	FIX1A		;MAX


.HASLEN:0			;LENGTH OF HASH TABLE (ARRAY)
.FULL:	0			;ON AFTER ANY LCONS FAILS, NO MORE LCONSES
.HASBAS:0			;COPIES BASE PTR OF LCONS ARRAY
.HASEND:0			;ONE PAST END OF ARRAY
BPRGSV:	0
BPRSV1:	0
BPNDSV:	0
FLAGSV:	0
NIL.NIL:0			;SPECIAL VALUE FOR (NIL) -- TO AVOID HASH CONFUSION
	END